home *** CD-ROM | disk | FTP | other *** search
/ Internet Surfer: Getting Started / Internet Surfer - Getting Started (Wayzata Technology)(7231)(1995).bin / pc / mac / bonus / peter_le / finger-1 / my_units / myfilesy.uni < prev    next >
Text File  |  1992-02-24  |  8KB  |  336 lines
  1. unit MyFileSystem;
  2.  
  3. { This code is part of the Finger/Fingerd source code, written in THINK Pascal 4 }
  4. { Copyright 1991-1992 Peter N Lewis }
  5. { If you use this code, you must give me credit in your about box and documentation }
  6. { This is part of my generic library of routines }
  7.  
  8. interface
  9.  
  10.     const
  11.         PAvailable = fsCurPerm;
  12.         PIn = fsRdPerm;
  13.         POut = fsWrPerm;
  14.         PInOut = fsRdWrPerm;
  15.         PShared = fsRdWrShPerm;
  16.         buf_size = 2048;
  17.         eof_byte = $1A;
  18.  
  19.     type
  20.         bufferArray = packed array[0..buf_size] of byte;
  21.         bufferPtr = ^bufferArray;
  22.         bufferHandle = ^bufferPtr;
  23.         MFSfile = record
  24.                 reading: boolean;
  25.                 rn: integer;
  26.                 buf_len, buf_pos: longInt;
  27.                 eof: boolean;
  28.                 length: longInt;
  29.                 buf: bufferHandle;
  30.             end;
  31.  
  32.     function MFSExists (wdrn: integer; dirID: longInt; name: str255): boolean;
  33.     function MFSDirExists (wdrn: integer; dirID: longInt; name: str255): boolean;
  34.     procedure MFSUniqueName (wdrn: integer; dirID: longInt; var name: str63);
  35.     function MFSOpenIn (wdrn: integer; dirID: longInt; name: str255; var thefile: MFSfile): OSErr;
  36.     function MFSCreate (wdrn: integer; dirID: longInt; name: str255; c, t: OSType): OSErr;
  37. {    function MFSDelete (wdrn: integer; dirID: longInt; name: str255): OSErr;}
  38. { use HDelete instead}
  39.     function MFSOpenOutDF (wdrn: integer; dirID: longInt; name: str255; c, t: OSType; var thefile: MFSfile): OSErr;
  40.     function MFSOpenOutRF (wdrn: integer; dirID: longInt; name: str255; c, t: OSType; var thefile: MFSfile): OSErr;
  41.     function MFSEof (var thefile: MFSfile): boolean;
  42.     function MFSLength (var thefile: MFSfile): longInt;
  43.     function MFSReadByte (var thefile: MFSfile; var b: byte): OSErr;
  44.     function MFSWriteByte (var thefile: MFSfile; b: byte): OSErr;
  45.     function MFSClose (var thefile: MFSfile): OSErr;
  46.     function MFSOpenDF (var rn: integer; wdrn: integer; dirID: longInt; name: str63; perm: integer): OSErr;
  47.     function MFSOpenRF (var rn: integer; wdrn: integer; dirID: longInt; name: str63; perm: integer): OSErr;
  48. { perm = fsCurPerm, fsRdPerm, fsWrPerm, fsRdWrPerm, fsRdWrShPerm }
  49.     procedure SegmentMFSByte;
  50.     procedure SegmentMFS;
  51.  
  52. implementation
  53.  
  54.     uses
  55.         MyTypes;
  56.  
  57. {$S MFSByte}
  58.     procedure SegmentMFSByte;
  59.     begin
  60.     end;
  61.  
  62. {$S MFS}
  63.     procedure SegmentMFS;
  64.     begin
  65.     end;
  66.  
  67. {$S MFSByte}
  68.     procedure InitTheFile (var thefile: MFSfile);
  69.     begin
  70.         thefile.buf := bufferHandle(NewHandle(buf_size));
  71.     end;
  72.  
  73. {$S MFS}
  74.     function MFSExists (wdrn: integer; dirID: longInt; name: str255): boolean;
  75.         var
  76.             pb: HParamBlockRec;
  77.     begin
  78.         with pb do begin
  79.             ioNamePtr := @name;
  80.             ioVRefNum := wdrn;
  81.             ioDirID := dirID;
  82.             ioFDirIndex := 0;
  83.         end;
  84.         MFSExists := PBHGetFInfo(@pb, false) = noErr;
  85.     end;
  86.  
  87. {$S MFS}
  88.     function MFSDirExists (wdrn: integer; dirID: longInt; name: str255): boolean;
  89.         var
  90.             pb: HParamBlockRec;
  91.             oe: OSErr;
  92.     begin
  93.         with pb do begin
  94.             ioNamePtr := @name;
  95.             ioVRefNum := wdrn;
  96.             ioDirID := dirID;
  97.             if name = '' then
  98.                 ioFDirIndex := -1
  99.             else
  100.                 ioFDirIndex := 0;
  101.         end;
  102.         oe := PBGetCatInfo(@pb, false);
  103.         MFSDirExists := (oe = noErr) and (BAND(pb.ioFlAttrib, $0010) <> 0);
  104.     end;
  105.  
  106. {$S MFS}
  107.     procedure MFSUniqueName (wdrn: integer; dirID: longInt; var name: str63);
  108.         var
  109.             base: str31;
  110.             n: integer;
  111.     begin
  112.         if MFSExists(wdrn, dirID, name) then begin
  113.             base := Concat(Copy(name, 1, 27), '#');
  114.             n := 1;
  115.             repeat
  116.                 name := Concat(base, chr(n div 100 + 48), chr(n div 10 mod 10 + 48), chr(n mod 10 + 48));
  117.                 n := n + 1;
  118.             until not MFSExists(wdrn, dirID, name);
  119.         end;
  120.     end;
  121.  
  122. {$S MFSByte}
  123.     function MFSOpenIn (wdrn: integer; dirID: longInt; name: str255; var thefile: MFSfile): OSErr;
  124.     begin
  125.         InitTheFile(thefile);
  126.         with thefile do begin
  127.             reading := true;
  128.             buf_pos := 0;
  129.             buf_len := 0;
  130.             MFSOpenIn := MFSOpenDF(rn, wdrn, dirID, name, PIn);
  131.             if GetEOF(rn, length) <> noErr then
  132.                 length := 0;
  133.             eof := length = 0;
  134.         end;
  135.     end;
  136.  
  137. {$S MFS}
  138.     function MFSCreate (wdrn: integer; dirID: longInt; name: str255; c, t: OSType): OSErr;
  139.         var
  140.             ooe, oe: integer;
  141.             fi: Finfo;
  142.     begin
  143.         oe := HCreate(wdrn, dirID, name, c, t);
  144.         if oe = dupFNErr then begin
  145.             ooe := HGetFInfo(wdrn, dirID, name, fi);
  146.             oe := HDelete(wdrn, dirID, name);
  147.             oe := HCreate(wdrn, dirID, name, c, t);
  148.             if (oe = noErr) and (ooe = noErr) then begin
  149.                 fi.fdType := t;
  150.                 fi.fdCreator := c;
  151.                 ooe := HSetFInfo(wdrn, dirID, name, fi);
  152.             end;
  153.         end;
  154.         MFSCreate := oe;
  155.     end;
  156.  
  157. {$S MFSByte}
  158.     function MFSOpenOutDF (wdrn: integer; dirID: longInt; name: str255; c, t: OSType; var thefile: MFSfile): OSErr;
  159.         var
  160.             oe: integer;
  161.             fi: fInfo;
  162.     begin
  163.         InitTheFile(thefile);
  164.         with thefile do begin
  165.             reading := false;
  166.             oe := MFSCreate(wdrn, dirID, name, c, t);
  167.             if oe = noErr then
  168.                 oe := MFSOpenDF(rn, wdrn, dirID, name, POut);
  169.             buf_pos := 0;
  170.             buf_len := 0;
  171.             length := 0;
  172.             eof := false;
  173.             MFSOpenOutDF := oe;
  174.         end;
  175.     end;
  176.  
  177. {$S MFSByte}
  178.     function MFSOpenOutRF (wdrn: integer; dirID: longInt; name: str255; c, t: OSType; var thefile: MFSfile): OSErr;
  179.         var
  180.             oe: integer;
  181.     begin
  182.         InitTheFile(thefile);
  183.         with thefile do begin
  184.             reading := false;
  185.             oe := MFSCreate(wdrn, dirID, name, c, t);
  186.             if oe = dupFNErr then
  187.                 oe := noErr;
  188.             if oe = noErr then
  189.                 oe := MFSOpenRF(rn, wdrn, dirID, name, POut);
  190.             buf_pos := 0;
  191.             buf_len := 0;
  192.             length := 0;
  193.             eof := false;
  194.             MFSOpenOutRF := oe;
  195.         end;
  196.     end;
  197.  
  198. {$S MFSByte}
  199.     function MFSLength (var thefile: MFSfile): longInt;
  200.         var
  201.             l: longInt;
  202.     begin
  203.         MFSLength := thefile.length;
  204.     end;
  205.  
  206. {$S MFSByte}
  207.     function MFSEof (var thefile: MFSfile): boolean;
  208.     begin
  209.         MFSEof := thefile.eof;
  210.     end;
  211.  
  212. {$S MFSByte}
  213.     function MFSReadByte (var thefile: MFSfile; var b: byte): OSErr;
  214.         var
  215.             oe: OSErr;
  216.         procedure Read;
  217.         begin
  218.             with thefile do begin
  219.                 buf_pos := 0;
  220.                 buf_len := buf_size;
  221.                 oe := FSRead(rn, buf_len, POINTER(buf^));
  222.                 if oe = eofErr then
  223.                     oe := noErr;
  224.                 if buf_len = 0 then
  225.                     oe := eofErr;
  226.                 if oe <> noErr then begin
  227.                     buf_len := 0;
  228.                     eof := true;
  229.                 end;
  230.             end;
  231.         end;
  232.     begin
  233.         with thefile do
  234.             if reading then begin
  235.                 if eof then begin
  236.                     b := eof_byte;
  237.                     MFSReadByte := eofErr;
  238.                 end
  239.                 else begin
  240.                     oe := noErr;
  241.                     if buf_pos = buf_len then
  242.                         Read;
  243.                     MFSReadByte := oe;
  244.                     if oe = noErr then begin
  245.                         b := buf^^[buf_pos];
  246.                         buf_pos := buf_pos + 1;
  247.                         if buf_pos = buf_len then
  248.                             Read;
  249.                     end;
  250.                 end;
  251.             end
  252.             else
  253.                 MFSReadByte := paramErr;
  254.     end;
  255.  
  256. {$S MFSByte}
  257.     function Flush (var thefile: MFSfile): OSErr;
  258.         var
  259.             count: longInt;
  260.             oe: integer;
  261.     begin
  262.         with thefile do begin
  263.             count := buf_pos;
  264.             if count = 0 then
  265.                 oe := noErr
  266.             else
  267.                 oe := FSWrite(rn, count, POINTER(buf^));
  268.             if count <> buf_pos then
  269.                 oe := ioErr;
  270.             buf_len := 0;
  271.             buf_pos := 0;
  272.         end;
  273.         Flush := oe;
  274.     end;
  275.  
  276. {$S MFSByte}
  277.     function MFSWriteByte (var thefile: MFSfile; b: byte): OSErr;
  278.     begin
  279.         with thefile do
  280.             if not reading then begin
  281.                 buf^^[buf_pos] := b;
  282.                 buf_pos := buf_pos + 1;
  283.                 if buf_pos = buf_size then
  284.                     MFSWriteByte := Flush(thefile)
  285.                 else
  286.                     MFSWriteByte := noErr;
  287.             end
  288.             else
  289.                 MFSWriteByte := paramErr;
  290.     end;
  291.  
  292. {$S MFSByte}
  293.     function MFSClose (var thefile: MFSfile): OSErr;
  294.         var
  295.             oe: integer;
  296.     begin
  297.         if not thefile.reading then
  298.             oe := Flush(thefile);
  299.         MFSClose := FSClose(thefile.rn);
  300.         thefile.rn := 0;                { Never close a file twice }
  301.         DisposHandle(handle(thefile.buf));
  302.     end;
  303.  
  304. {$S MFS}
  305.     function MFSOpenDF (var rn: integer; wdrn: integer; dirID: longInt; name: str63; perm: integer): OSErr;
  306.         var
  307.             pb: HParamBlockRec;
  308.     begin
  309.         with pb do begin
  310.             ioNamePtr := @name;
  311.             ioVRefNum := wdrn;
  312.             ioPermssn := perm;
  313.             ioMisc := nil;
  314.             ioDirID := dirID;
  315.             MFSOpenDF := PBHOpen(@pb, false);
  316.             rn := ioRefNum;
  317.         end;
  318.     end;
  319.  
  320. {$S MFS}
  321.     function MFSOpenRF (var rn: integer; wdrn: integer; dirID: longInt; name: str63; perm: integer): OSErr;
  322.         var
  323.             pb: HParamBlockRec;
  324.     begin
  325.         with pb do begin
  326.             ioNamePtr := @name;
  327.             ioVRefNum := wdrn;
  328.             ioPermssn := perm;
  329.             ioMisc := nil;
  330.             ioDirID := dirID;
  331.             MFSOpenRF := PBHOpenRF(@pb, false);
  332.             rn := ioRefNum;
  333.         end;
  334.     end;
  335.  
  336. end.